Evaluating demographics in Census Block Groups within 5 mile radius of the site:
library(tigris)
library(sf)
library(tidyverse)
library(mapview)
library(censusapi)
library(dplyr)
library(leaflet)
library(ggplot2)
library(plotly)
library(mapview)
# Narrowing down census block groups within a 5 mile radius of the site:
projection <- "+proj=utm +zone=10 +ellps=GRS80 +datum=NAD83 +units=ft +no_defs"
cbgs <- block_groups("CA","Santa Clara") %>%
st_transform(projection)
##
|
| | 0%
|
| | 1%
|
|= | 1%
|
|= | 2%
|
|== | 2%
|
|== | 3%
|
|== | 4%
|
|=== | 4%
|
|=== | 5%
|
|==== | 5%
|
|==== | 6%
|
|===== | 6%
|
|===== | 7%
|
|===== | 8%
|
|====== | 8%
|
|====== | 9%
|
|======= | 9%
|
|======= | 10%
|
|======= | 11%
|
|======== | 11%
|
|======== | 12%
|
|========= | 12%
|
|========= | 13%
|
|========== | 14%
|
|========== | 15%
|
|=========== | 15%
|
|=========== | 16%
|
|============ | 16%
|
|============ | 17%
|
|============ | 18%
|
|============= | 18%
|
|============= | 19%
|
|============== | 19%
|
|============== | 20%
|
|============== | 21%
|
|=============== | 21%
|
|=============== | 22%
|
|================ | 22%
|
|================ | 23%
|
|================ | 24%
|
|================= | 24%
|
|================= | 25%
|
|================== | 25%
|
|================== | 26%
|
|=================== | 26%
|
|=================== | 27%
|
|=================== | 28%
|
|==================== | 28%
|
|==================== | 29%
|
|===================== | 29%
|
|===================== | 30%
|
|===================== | 31%
|
|====================== | 31%
|
|====================== | 32%
|
|======================= | 32%
|
|======================= | 33%
|
|======================= | 34%
|
|======================== | 34%
|
|======================== | 35%
|
|========================= | 35%
|
|========================= | 36%
|
|========================== | 36%
|
|========================== | 37%
|
|========================== | 38%
|
|=========================== | 38%
|
|=========================== | 39%
|
|============================ | 39%
|
|============================ | 40%
|
|============================ | 41%
|
|============================= | 41%
|
|============================= | 42%
|
|============================== | 42%
|
|============================== | 43%
|
|============================== | 44%
|
|=============================== | 44%
|
|=============================== | 45%
|
|================================ | 45%
|
|================================ | 46%
|
|================================= | 46%
|
|================================= | 47%
|
|================================= | 48%
|
|================================== | 48%
|
|================================== | 49%
|
|=================================== | 49%
|
|=================================== | 50%
|
|=================================== | 51%
|
|==================================== | 51%
|
|==================================== | 52%
|
|===================================== | 52%
|
|===================================== | 53%
|
|===================================== | 54%
|
|====================================== | 54%
|
|====================================== | 55%
|
|======================================= | 55%
|
|======================================= | 56%
|
|======================================== | 56%
|
|======================================== | 57%
|
|======================================== | 58%
|
|========================================= | 58%
|
|========================================= | 59%
|
|========================================== | 59%
|
|========================================== | 60%
|
|========================================== | 61%
|
|=========================================== | 61%
|
|=========================================== | 62%
|
|============================================ | 62%
|
|============================================ | 63%
|
|============================================ | 64%
|
|============================================= | 64%
|
|============================================= | 65%
|
|============================================== | 65%
|
|============================================== | 66%
|
|=============================================== | 66%
|
|=============================================== | 67%
|
|=============================================== | 68%
|
|================================================ | 68%
|
|================================================ | 69%
|
|================================================= | 69%
|
|================================================= | 70%
|
|================================================= | 71%
|
|================================================== | 71%
|
|================================================== | 72%
|
|=================================================== | 72%
|
|=================================================== | 73%
|
|=================================================== | 74%
|
|==================================================== | 74%
|
|==================================================== | 75%
|
|===================================================== | 75%
|
|===================================================== | 76%
|
|====================================================== | 76%
|
|====================================================== | 77%
|
|====================================================== | 78%
|
|======================================================= | 78%
|
|======================================================= | 79%
|
|======================================================== | 79%
|
|======================================================== | 80%
|
|======================================================== | 81%
|
|========================================================= | 81%
|
|========================================================= | 82%
|
|========================================================== | 82%
|
|========================================================== | 83%
|
|========================================================== | 84%
|
|=========================================================== | 84%
|
|=========================================================== | 85%
|
|============================================================ | 85%
|
|============================================================ | 86%
|
|============================================================= | 86%
|
|============================================================= | 87%
|
|============================================================= | 88%
|
|============================================================== | 88%
|
|============================================================== | 89%
|
|=============================================================== | 89%
|
|=============================================================== | 90%
|
|=============================================================== | 91%
|
|================================================================ | 91%
|
|================================================================ | 92%
|
|================================================================= | 92%
|
|================================================================= | 93%
|
|================================================================= | 94%
|
|================================================================== | 94%
|
|================================================================== | 95%
|
|=================================================================== | 95%
|
|=================================================================== | 96%
|
|==================================================================== | 96%
|
|==================================================================== | 97%
|
|==================================================================== | 98%
|
|===================================================================== | 98%
|
|===================================================================== | 99%
|
|======================================================================| 99%
|
|======================================================================| 100%
site <- cbgs %>%
filter(GEOID == "060855087042") %>%
st_centroid() %>%
st_transform(projection)
neighborhood_cbgs <- site %>%
st_buffer(26400) %>%
cbgs[., ]
# Create Clean Sex by Age data frame within 5 mile radius:
Sys.setenv(CENSUS_KEY="6e3cadd908fdaf8f7d3d728f4faa99e738db811a")
acs_vars_2019_5yr <-
listCensusMetadata(
name = "2019/acs/acs5",
type = "variables"
)
sc_sexbyage <-
getCensus(
name = "acs/acs5",
vintage = 2019,
region = "block group:*",
regionin = "state:06+county:085",
vars = "group(B01001)"
)%>%
mutate(
cbg =
paste0(state,county,tract,block_group)
) %>%
select(!c(GEO_ID,state,county,tract,block_group,NAME) & !ends_with(c("EA","MA","M"))) %>%
pivot_longer(
ends_with("E"),
names_to = "variable",
values_to = "estimate"
) %>%
left_join(
acs_vars_2019_5yr %>%
select(name, label),
by = c("variable" = "name")
) %>%
select(-variable) %>%
separate(
label,
into = c(NA,NA,"sex","age"),
sep = "!!"
) %>%
filter(!is.na(age)) %>%
filter(cbg %in% neighborhood_cbgs$GEOID)
sc_elderly <-
sc_sexbyage %>%
mutate(
elderly =
ifelse(
age %in% c(
"65 and 66 years",
"67 to 69 years",
"70 to 74 years",
"75 to 79 years",
"80 to 84 years",
"85 years and over"
),
estimate,
NA
)
) %>%
group_by(cbg) %>%
summarize(
elderly = sum(elderly, na.rm = T),
total_pop = sum(estimate, na.rm = T)
) %>%
mutate(
percent_elderly = elderly/total_pop*100
) %>%
filter(!is.na(percent_elderly))
sum(sc_elderly$elderly)
## [1] 59921
# 11.8 % of the population is 65 years or older within a 5 mile radius of the site
elderly_pal <- colorNumeric(
palette = "Blues",
domain =
sc_elderly$percent_elderly
)
leaflet() %>%
addTiles() %>%
addPolygons(
data =
sc_elderly %>%
left_join(
neighborhood_cbgs %>% select(GEOID),
by = c("cbg" = "GEOID")
) %>%
st_as_sf() %>%
st_transform(4326),
fillColor = ~elderly_pal (percent_elderly),
color = "white",
opacity = 0.5,
fillOpacity = 0.5,
weight = 1,
label = ~paste0(
round(percent_elderly),
"% over age 65"
),
highlightOptions = highlightOptions(
weight = 2,
opacity = 1
)
) %>%
addLegend(
data = sc_elderly,
pal = elderly_pal,
values = ~percent_elderly,
title = "% over 65"
)
# Families receiving public assistance by family size within 5 miles of the site:
family_size <-
c(
"2-person families",
"3-person families",
"4-person families",
"5-person families",
"6-person families",
"7-or-more-person families"
)
sc_fm_assistance <-
getCensus(
name = "acs/acs5",
vintage = 2019,
region = "block group:*",
regionin = "state:06+county:085",
vars = "group(B19123)"
)%>%
mutate(
cbg =
paste0(state,county,tract,block_group)
) %>%
select(!c(GEO_ID,state,county,tract,block_group,NAME) & !ends_with(c("EA","MA","M"))) %>%
pivot_longer(
ends_with("E"),
names_to = "variable",
values_to = "estimate"
) %>%
left_join(
acs_vars_2019_5yr %>%
select(name, label),
by = c("variable" = "name")
) %>%
select(-variable) %>%
separate(
label,
into = c(NA,NA,"family_size","assistance_status"),
sep = "!!"
) %>%
filter(!is.na(assistance_status)) %>%
filter(cbg %in% neighborhood_cbgs$GEOID)
#Map: % of Families Receiving SNAP by size
sc_fm_SNAP <-
sc_fm_assistance
sc_pubassist <-
sc_fm_SNAP %>%
mutate(
pubassist =
ifelse(
assistance_status %in% c(
"With cash public assistance income or households receiving Food Stamps/SNAP benefits in the past 12 months"
),
estimate,
NA
)
) %>%
group_by(cbg) %>%
summarize(
pubassist = sum(pubassist, na.rm = T),
total_pop = sum(estimate, na.rm = T)
) %>%
mutate(
percent_pubassist = pubassist/total_pop*100
) %>%
filter(!is.na(percent_pubassist))
pubassist_pal <- colorNumeric(
palette = "Blues",
domain =
sc_pubassist$percent_pubassist
)
leaflet() %>%
addTiles() %>%
addPolygons(
data =
sc_pubassist %>%
left_join(
neighborhood_cbgs %>% select(GEOID),
by = c("cbg" = "GEOID")
) %>%
st_as_sf() %>%
st_transform(4326),
fillColor = ~pubassist_pal (percent_pubassist),
color = "white",
opacity = 0.5,
fillOpacity = 0.5,
weight = 1,
label = ~paste0(
round(percent_pubassist),
"% Receiving Public Assistance or SNAP"
),
highlightOptions = highlightOptions(
weight = 2,
opacity = 1
)
) %>%
addLegend(
data = sc_pubassist,
pal = pubassist_pal,
values = ~percent_pubassist,
title = "% Families Receiving Public Assistance or SNAP"
)
#Filled Plot:
sc_fm_assistance %>%
group_by(family_size, assistance_status) %>%
summarize(estimate = sum(estimate)) %>%
ggplot() +
geom_bar(
aes(
x = assistance_status %>% factor(),
y = estimate,
fill = family_size
),
stat = "identity",
position = "fill"
) +
labs(
x = "Public Assistance Status",
y = "Proportion of families receiving public assistance",
title = "Families Receiving Public Assistance by Size",
fill = "Size of Family"
) +
coord_flip() +
theme(
legend.position = "bottom",
legend.direction = "vertical"
) + scale_x_discrete(label = function(x) stringr::str_trunc(x, 12))
#Stacked Plot:
sc_fm_assistance %>%
group_by(family_size, assistance_status) %>%
summarize(estimate = sum(estimate)) %>%
ggplot() +
geom_bar(
aes(
x = assistance_status %>% factor(),
y = estimate,
fill = family_size
),
stat = "identity",
position = "stack"
) +
labs(
x = "Public Assistance Status",
y = "Number of families receiving public assistance",
title = "Families Receiving Public Assistance by Size",
fill = "Size of Family"
) +
coord_flip() +
theme(
legend.position = "bottom",
legend.direction = "vertical"
) + scale_x_discrete(label = function(x) stringr::str_trunc(x, 12))
# Families receiving public assistance by type:
sc_assist_total <-
sc_fm_assistance %>%
group_by(assistance_status) %>%
summarize(estimate = sum(estimate)) %>%
mutate(family_size = "Total")
sc_assist_totalfm <-
sc_fm_assistance %>%
group_by(family_size) %>%
summarize(estimate = sum(estimate)) %>%
mutate(assistance_status = "Total")
# Percent of Families receiving public assistance:
((sum(sc_assist_total$estimate[2])/sum(sc_assist_total$estimate))*100) %>% round()
## [1] 3
# Percent of 2-person families or less receiving public assistance:
((sum(sc_assist_totalfm$estimate[1])/sum(sc_assist_totalfm$estimate))*100) %>% round()
## [1] 42
((sum(sc_assist_totalfm$estimate[2:3])/sum(sc_assist_totalfm$estimate))*100) %>% round()
## [1] 48
# Poverty Status in the past 12 months by Age:
sc_povbyage <-
getCensus(
name = "acs/acs5",
vintage = 2019,
region = "county:085",
regionin = "state:06",
vars = "group(B17001)"
) %>%
select(!c(GEO_ID,state,NAME) & !ends_with(c("EA","MA","M"))) %>%
pivot_longer(
ends_with("E"),
names_to = "variable",
values_to = "estimate"
) %>%
left_join(
acs_vars_2019_5yr %>%
select(name, label),
by = c("variable" = "name")
) %>%
select(-variable) %>%
separate(
label,
into = c(NA,NA,"income", "sex","age"),
sep = "!!"
) %>%
filter(!is.na(age))
sc_elderly_pov <-
sc_povbyage %>%
mutate(
elderly =
ifelse(
age %in% c(
"65 to 74 years",
"75 years and over"
),
estimate,
NA
)
) %>%
group_by(income) %>%
summarize(
elderly = sum(elderly, na.rm = T),
total_pop = sum(estimate, na.rm = T)
) %>%
mutate(
percent_elderly = elderly/total_pop*100
) %>%
filter(!is.na(percent_elderly))
sc_elderly_pov_sex <-
sc_povbyage %>%
mutate(
elderly =
ifelse(
age %in% c(
"65 to 74 years",
"75 years and over"
),
estimate,
NA
)
) %>%
group_by(sex, income) %>%
summarize(
elderly = sum(elderly, na.rm = T),
total_pop = sum(estimate, na.rm = T)
) %>%
mutate(
percent_elderly = elderly/total_pop*100
) %>%
filter(!is.na(percent_elderly))
sc_mid_pov_sex <-
sc_povbyage %>%
mutate(
mid =
ifelse(
age %in% c(
"34 to 44 years",
"45 to 54 years",
"55 to 64 years"
),
estimate,
NA
)
) %>%
group_by(sex, income) %>%
summarize(
mid = sum(mid, na.rm = T),
total_pop = sum(estimate, na.rm = T)
) %>%
mutate(
percent_mid = mid/total_pop*100
) %>%
filter(!is.na(percent_mid))
sc_youngadult_pov <-
sc_povbyage %>%
mutate(
young =
ifelse(
age %in% c(
"18 to 24 years",
"25 to 34 years"
),
estimate,
NA
)
) %>%
group_by(income) %>%
summarize(
young = sum(young, na.rm = T),
total_pop = sum(estimate, na.rm = T)
) %>%
mutate(
percent_young = young/total_pop*100
) %>%
filter(!is.na(percent_young))
sc_youngadult_pov_sex <-
sc_povbyage %>%
mutate(
young =
ifelse(
age %in% c(
"18 to 24 years",
"25 to 34 years"
),
estimate,
NA
)
) %>%
group_by(sex, income) %>%
summarize(
young = sum(young, na.rm = T),
total_pop = sum(estimate, na.rm = T)
) %>%
mutate(
percent_young = young/total_pop*100
) %>%
filter(!is.na(percent_young))
# Poverty Status in the past 12 months by Race: County Level
census_race_labels <-
c(
"White Alone",
"Black or African American",
"American Indian and Alaska Native Alone",
"Asian Alone",
"Native Hawaiian and Other Pacific Islander Alone)",
"Some Other Race Alone",
"Two or More Races"
)
sc_poverty_race <-
1:7 %>%
map_dfr(function(x){
getCensus(
name = "acs/acs5",
vintage = 2019,
region = "county:085",
regionin = "state:06",
vars = paste0("group(B17001",LETTERS[x],")")
) %>%
select(!c(GEO_ID,state,NAME) & !ends_with(c("EA","MA","M"))) %>%
pivot_longer(
ends_with("E"),
names_to = "variable",
values_to = "estimate"
) %>%
left_join(
acs_vars_2019_5yr %>%
select(name, label),
by = c("variable" = "name")
) %>%
select(-variable) %>%
separate(
label,
into = c(NA, NA, "income", "sex", "age"),
sep = "!!"
) %>% filter(!is.na(age)) %>%
filter(!is.na(income)) %>%
mutate(race = census_race_labels[x])
})
# Filled Plot:
sc_poverty_race %>%
group_by(income, race) %>%
summarize(estimate = sum(estimate)) %>%
ggplot() +
geom_bar(
aes(
x = income %>% factor(),
y = estimate,
fill = race
),
stat = "identity",
position = "fill"
) +
labs(
x = "Income level in relation to poverty level",
y = "Race of Respondents",
title = "Poverty Status in the Past 12 Months",
fill = "Race "
) +
coord_flip() +
theme(
legend.position = "bottom",
legend.direction = "vertical"
)
# Chart: Percentage of Young Adults in Poverty SC County
sc_poverty_youngadult <-
sc_poverty_race %>%
mutate(
youngadult =
ifelse(
age %in% c(
"25 to 34 years",
"35 to 44 years"
),
estimate,
NA
)
) %>%
group_by(race, income) %>%
summarize(
youngadult = sum(youngadult, na.rm = T),
total_pop = sum(estimate, na.rm = T)
) %>%
mutate(
percent_youngadult = youngadult/total_pop*100
) %>%
filter(!is.na(percent_youngadult)) %>%
filter(!is.na(income))
#Pie Charts:
youngadult_pov_chart <-
sc_poverty_youngadult%>%
filter(income %in% "Income in the past 12 months below poverty level:") %>%
group_by(income, race) %>%
summarize(percent_youngadult = sum(percent_youngadult))
youngadult_pov_fig <-
plot_ly(youngadult_pov_chart, labels = ~race, values = ~percent_youngadult,
type = 'pie',
textposition = 'outside',
textinfo = 'percent',
outsidetextfont = list(color = '#404040'),
hoverinfo = 'text',
text = ~paste(percent_youngadult, 'respondents'),
marker = list(colors = colors,
line = list(color = '#FFFFFF', width = 0.5)),
showlegend = TRUE)
youngadult_pov_fig <-
youngadult_pov_fig %>%
layout(title = "% Respondents 24-34 below the poverty line in the past 12 months",
xaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE, cex.lab = 0.5),
yaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE))
youngadult_pov_fig
saveRDS(youngadult_pov_fig, "youngadult_pov_fig.rds")
# Chart: Percentage of Elderly in Poverty SC County
sc_poverty_elderly <-
sc_poverty_race %>%
mutate(
elderly =
ifelse(
age %in% c(
"65 to 74 years",
"75 years and older"
),
estimate,
NA
)
) %>%
group_by(race, income) %>%
summarize(
elderly = sum(elderly, na.rm = T),
total_pop = sum(estimate, na.rm = T)
) %>%
mutate(
percent_elderly = elderly/total_pop*100
) %>%
filter(!is.na(percent_elderly)) %>%
filter(!is.na(income))
#Pie Chart:
elderly_pov_chart <-
sc_poverty_elderly%>%
filter(income %in% "Income in the past 12 months below poverty level:") %>%
group_by(income, race) %>%
summarize(percent_elderly = sum(percent_elderly))
elderly_pov_fig <-
plot_ly(elderly_pov_chart, labels = ~race, values = ~percent_elderly,
type = 'pie',
textposition = 'outside',
textinfo = 'percent',
outsidetextfont = list(color = '#404040'),
hoverinfo = 'text',
text = ~paste(percent_elderly, 'respondents'),
marker = list(colors = colors,
line = list(color = '#FFFFFF', width = 0.5)),
showlegend = TRUE)
elderly_pov_fig <-
elderly_pov_fig %>%
layout(title = "% Respondents above 65 below the poverty line in the past 12 months",
xaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE, cex.lab = 0.5),
yaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE))
# Sum of those in poverty:
sum(sc_poverty_elderly$percent_elderly)
## [1] 78.3499
elderly_pov_fig
saveRDS(elderly_pov_fig, "elderly_pov_fig.rds")
# Households by type:
census_subfam_labels <-
c(
"Married-Couple subfamily",
"Mother-child subfamily",
"Father-child subfamily"
)
sc_housebytype <-
getCensus(
name = "acs/acs5",
vintage = 2019,
region = "county:085",
regionin = "state:06",
vars = "group(B11013)"
)%>%
select(!c(GEO_ID,state,NAME) & !ends_with(c("EA","MA","M"))) %>%
pivot_longer(
ends_with("E"),
names_to = "variable",
values_to = "estimate"
) %>%
left_join(
acs_vars_2019_5yr %>%
select(name, label),
by = c("variable" = "name")
) %>%
select(-variable) %>%
separate(
label,
into = c(NA,NA,"subfamily","own_children"),
sep = "!!"
) %>% filter(!is.na(subfamily))
sc_subfam_total <-
sc_housebytype %>%
group_by(subfamily) %>%
summarize(estimate = sum(estimate)) %>%
mutate(own_children = "Total")
# Percent of mother-child subfamilies: 23%
((sum(sc_subfam_total$estimate[3])/sum(sc_subfam_total$estimate))*100) %>% round()
## [1] 23
#Percent of married subfamilies: 70%
((sum(sc_subfam_total$estimate[2])/sum(sc_subfam_total$estimate))*100) %>% round()
## [1] 70
# Income mobility data:
library(tidyverse)
library(censusapi)
library(dplyr)
Sys.setenv(CENSUS_KEY="6e3cadd908fdaf8f7d3d728f4faa99e738db811a")
acs_vars_2019_1yr <-
listCensusMetadata(
name = "2019/acs/acs1",
type = "variables"
)
sc_mobility_current_19 <-
getCensus(
name = "acs/acs1",
vintage = 2019,
region = "county:085",
regionin = "state:06",
vars = c("group(B07010)")
) %>%
select(!c(GEO_ID,state,NAME) & !ends_with(c("EA","MA","M"))) %>%
pivot_longer(
ends_with("E"),
names_to = "variable",
values_to = "estimate"
) %>%
left_join(
acs_vars_2019_1yr %>%
select(name, label),
by = c("variable" = "name")
) %>%
select(-variable) %>%
separate(
label,
into = c(NA,NA,"mobility","temp","income"),
sep = "!!"
) %>%
mutate(
income = ifelse(
temp == "No income",
temp,
income
),
mobility = ifelse(
mobility %in% c("Same house 1 year ago:", "Moved within same county:"),
"Here since last year",
"Inflow"
)
) %>%
filter(!is.na(income)) %>%
group_by(mobility, income) %>%
summarize(estimate = sum(estimate))
sc_mobility_lastyear_19 <-
getCensus(
name = "acs/acs1",
vintage = 2019,
region = "county:085",
regionin = "state:06",
vars = c("group(B07410)")
) %>%
select(!c(GEO_ID,state,NAME) & !ends_with(c("EA","MA","M"))) %>%
pivot_longer(
ends_with("E"),
names_to = "variable",
values_to = "estimate"
) %>%
left_join(
acs_vars_2019_1yr %>%
select(name, label),
by = c("variable" = "name")
) %>%
select(-variable) %>%
separate(
label,
into = c(NA,NA,"mobility","temp","income"),
sep = "!!"
) %>%
mutate(
income = ifelse(
temp == "No income",
temp,
income
),
mobility = ifelse(
mobility %in% c("Same house:", "Moved within same county:"),
"Here since last year",
"Outflow"
)
) %>%
filter(!is.na(income)) %>%
group_by(mobility, income) %>%
summarize(estimate = sum(estimate))
sc_mobility_current_18 <-
getCensus(
name = "acs/acs1",
vintage = 2018,
region = "county:085",
regionin = "state:06",
vars = c("group(B07010)")
) %>%
select(!c(GEO_ID,state,NAME) & !ends_with(c("EA","MA","M"))) %>%
pivot_longer(
ends_with("E"),
names_to = "variable",
values_to = "estimate"
) %>%
left_join(
acs_vars_2019_1yr %>%
select(name, label),
by = c("variable" = "name")
) %>%
select(-variable) %>%
separate(
label,
into = c(NA,NA,"mobility","temp","income"),
sep = "!!"
) %>%
mutate(
income = ifelse(
temp == "No income",
temp,
income
),
mobility = "Here last year"
) %>%
filter(!is.na(income)) %>%
group_by(mobility, income) %>%
summarize(estimate = sum(estimate))
sc_flows_19 <-
rbind(
sc_mobility_current_18,
sc_mobility_lastyear_19 %>%
filter(mobility == "Outflow"),
sc_mobility_current_19 %>%
filter(mobility == "Inflow"),
sc_mobility_current_19 %>%
group_by(income) %>%
summarize(estimate = sum(estimate)) %>%
mutate(mobility = "Here this year")
) %>%
pivot_wider(
names_from = mobility,
values_from = estimate
) %>%
mutate(
`External net` = Inflow - Outflow,
`Internal net` = `Here this year` - `Here last year` - `External net`,
) %>%
select(
`Income tier` = income,
`Internal net`,
`External net`,
`Here last year`,
`Here this year`,
Outflow,
Inflow
)
sc_flows_19
## # A tibble: 9 x 7
## `Income tier` `Internal net` `External net` `Here last year` `Here this year`
## <chr> <dbl> <dbl> <dbl> <dbl>
## 1 $1 to $9,999~ -6536 -893 181370 173941
## 2 $10,000 to $~ -8932 650 99016 90734
## 3 $15,000 to $~ -13190 -1618 143377 128569
## 4 $25,000 to $~ -63 -1469 121686 120154
## 5 $35,000 to $~ 9419 1810 135375 146604
## 6 $50,000 to $~ 2179 237 116889 119305
## 7 $65,000 to $~ -3625 -203 63497 59669
## 8 $75,000 or m~ 23339 4105 494087 521531
## 9 No income -10721 4024 229111 222414
## # ... with 2 more variables: Outflow <dbl>, Inflow <dbl>